home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbactf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  6.8 KB  |  175 lines
  1. (*===========================================================================*)
  2. (* Action command processor                                                  *)
  3. (*                                                                           *)
  4. (*   Copyright 1990, 1991, 1992 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. (*===========================================================================*)
  9. (* Free action                                                               *)
  10. (*===========================================================================*)
  11.  
  12. PROCEDURE free_action;
  13.  
  14.   VAR
  15.     a_type           : action_msg_type;
  16.     i                : WORD;
  17.     next_msg_action  : action_msg_ptr;
  18.     next_search      : search_block_ptr;
  19.     this_search      : search_block_ptr;
  20.  
  21.   CONST
  22.     action_msg_short1 = action_msg_change OR action_msg_invert;
  23.     action_msg_short2 = action_msg_deny   OR action_msg_invert;
  24.  
  25.     action_msg_0     = action_msg_hold
  26.                        OR action_msg_review
  27.                        OR action_msg_reject
  28.                        OR action_msg_old ;
  29.  
  30.     action_msg_1     = action_msg_distr;
  31.  
  32.     action_msg_2     = action_msg_deny;
  33.  
  34.   action_msg_invert = $01;        (* Negate the test                         *)
  35.  
  36.   LABEL free_action_now;
  37.  
  38.   BEGIN;
  39.  
  40.     {$IFDEF DEBUG1}
  41.       WRITELN('Free action start');
  42.       DELAY(1000);
  43.     {$ENDIF}
  44.  
  45.     (*-----------------------------------------------------------------------*)
  46.     (* Loop thru all the actions                                             *)
  47.     (*-----------------------------------------------------------------------*)
  48.  
  49.     WHILE first_msg_action <> NIL DO
  50.       BEGIN;
  51.  
  52.         {$IFDEF POINT_CHK}
  53.           test_pointer(first_msg_action);
  54.         {$ENDIF}
  55.  
  56.         (*-------------------------------------------------------------------*)
  57.         (* Chain to the next action                                          *)
  58.         (*-------------------------------------------------------------------*)
  59.  
  60.         next_msg_action := first_msg_action^.next_action;
  61.  
  62.         (*-------------------------------------------------------------------*)
  63.         (* Discard the search blocks if any                                  *)
  64.         (*-------------------------------------------------------------------*)
  65.  
  66.         next_search := first_msg_action^.action_srch;
  67.         WHILE next_search <> NIL DO
  68.           BEGIN;
  69.  
  70.             {$IFDEF POINT_CHK}
  71.               test_pointer(next_search);
  72.             {$ENDIF}
  73.  
  74.             this_search := next_search;
  75.             next_search := this_search^.search_next;
  76.  
  77.             FREEMEM(this_search, length_search_block(this_search));
  78.  
  79.           END;
  80.  
  81.         (*-------------------------------------------------------------------*)
  82.         (* Get the type somewhere handy                                      *)
  83.         (*-------------------------------------------------------------------*)
  84.  
  85.         a_type := first_msg_action^.action_type;
  86.  
  87.         (*-------------------------------------------------------------------*)
  88.         (* Handle FORMAT0.  This includes both CHANGE_ADR and DENY_NEW_MSG   *)
  89.         (* with the NO                                                       *)
  90.         (*-------------------------------------------------------------------*)
  91.  
  92.         IF ((a_type AND action_msg_0) <> 0)
  93.                    OR ((a_type AND action_msg_short1) = action_msg_short1)
  94.                    OR ((a_type AND action_msg_short2) = action_msg_short2) THEN
  95.           BEGIN
  96.             i := action_msg_overhead + WORD(1)
  97.                                        + LENGTH(first_msg_action^.action_info);
  98.             GOTO free_action_now;
  99.           END;
  100.  
  101.         (*-------------------------------------------------------------------*)
  102.         (* Handle CHANGE_ADR                                                 *)
  103.         (*-------------------------------------------------------------------*)
  104.  
  105.         IF a_type = action_msg_change THEN
  106.           BEGIN;
  107.             i := 1 + LENGTH(first_msg_action^.action_info);
  108.             INC(i, ORD(first_msg_action^.action_info[i]) + 1);
  109.             INC(i, ORD(first_msg_action^.action_info[i]) + 1);
  110.             INC(i, ORD(first_msg_action^.action_info[i])
  111.                                               + WORD(1) + action_msg_overhead);
  112.             GOTO free_action_now;
  113.           END;
  114.  
  115.         (*-------------------------------------------------------------------*)
  116.         (* Handle Format 1                                                   *)
  117.         (*-------------------------------------------------------------------*)
  118.  
  119.         IF a_type = action_msg_1 THEN
  120.           BEGIN;
  121.             i := 1 + LENGTH(first_msg_action^.action_info);
  122.             INC(i, ORD(first_msg_action^.action_info[i])
  123.                                                     + 1 + action_msg_overhead);
  124.             GOTO free_action_now;
  125.           END;
  126.  
  127.         (*-------------------------------------------------------------------*)
  128.         (* Handle Format 2                                                   *)
  129.         (*-------------------------------------------------------------------*)
  130.  
  131.         IF a_type = action_msg_2 THEN
  132.           BEGIN;
  133.             i := 1 + WORD(LENGTH(first_msg_action^.action_info))
  134.                    + SIZEOF(WORD) + action_msg_overhead;
  135.             GOTO free_action_now;
  136.           END;
  137.  
  138.         (*-------------------------------------------------------------------*)
  139.         (* If we reach here, the action stuff is screwed up                  *)
  140.         (*-------------------------------------------------------------------*)
  141.  
  142.         WRITELN('Action free failure for code ', a_type);
  143.         RUNERROR(action_error);
  144.  
  145.         (*-------------------------------------------------------------------*)
  146.         (* Free the thing now                                                *)
  147.         (*-------------------------------------------------------------------*)
  148.  
  149. free_action_now:
  150.  
  151.         {$IFDEF DEBUG3}
  152.           trace_data('ACF', i , first_msg_action, '');
  153.         {$ENDIF}
  154.  
  155.         FREEMEM(first_msg_action, i);
  156.  
  157.         {$IFDEF FREE_CHECK}
  158.           test_free_list;
  159.         {$ENDIF}
  160.  
  161.         (*-------------------------------------------------------------------*)
  162.         (* Point to next action                                              *)
  163.         (*-------------------------------------------------------------------*)
  164.  
  165.         first_msg_action := next_msg_action;
  166.  
  167.       END; (*----- End of loop thru all the actions -------------------------*)
  168.  
  169.     {$IFDEF DEBUG1}
  170.       WRITELN('Free action end');
  171.       DELAY(1000);
  172.     {$ENDIF}
  173.  
  174.   END;
  175.